home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / RCOMP.C < prev    next >
Text File  |  1990-03-02  |  10KB  |  441 lines
  1. /*
  2.  * File: rcomp.c
  3.  *  Contents: anycmp, equiv, lexcmp, numcmp
  4.  */
  5.  
  6. #include "::h:config.h"
  7. #include "::h:rt.h"
  8. #include "rproto.h"
  9.  
  10. /*
  11.  * anycmp - compare any two objects.
  12.  */
  13.  
  14. int anycmp(dp1,dp2)
  15. dptr dp1, dp2;
  16.    {
  17.    register int o1, o2;
  18.    register long lresult;
  19.    double rres1, rres2, rresult;
  20.  
  21.    /*
  22.     * Get a collating number for dp1 and dp2.
  23.     */
  24.    o1 = order(dp1);
  25.    o2 = order(dp2);
  26.  
  27.    /*
  28.     * If dp1 and dp2 aren't of the same type, compare their collating numbers.
  29.     */
  30.    if (o1 != o2)
  31.       return (o1 > o2 ? Greater : Less);
  32.  
  33.    if (o1 == 3)
  34.       /*
  35.        * dp1 and dp2 are strings, use lexcmp to compare them.
  36.        */
  37.       return lexcmp(dp1,dp2);
  38.  
  39.    switch (Type(*dp1)) {
  40.       case T_Integer:
  41.      lresult = IntVal(*dp1) - IntVal(*dp2);
  42.      if (lresult == 0)
  43.         return Equal;
  44.      return ((lresult > 0) ? Greater : Less);
  45.  
  46. #ifdef LargeInts
  47.       case T_Bignum:
  48.      lresult = bigcmp(dp1, dp2);
  49.      if (lresult == 0)
  50.         return Equal;
  51.      return ((lresult > 0) ? Greater : Less);
  52. #endif                    /* LargeInts */
  53.  
  54.       case T_Real:
  55.          GetReal(dp1,rres1);
  56.          GetReal(dp2,rres2);
  57.          rresult = rres1 - rres2;
  58.      if (rresult == 0.0)
  59.         return Equal;
  60.      return ((rresult > 0.0) ? Greater : Less);
  61.  
  62.       case T_Null:
  63.          return Equal;
  64.  
  65.       case T_Cset:
  66.          return csetcmp((unsigned int *)((struct b_cset *)BlkLoc(*dp1))->bits,
  67.             (unsigned int *)((struct b_cset *)BlkLoc(*dp2))->bits);
  68.  
  69.       case T_File:
  70.       case T_Proc:
  71.       case T_List:
  72.       case T_Table:
  73.       case T_Set:
  74.       case T_Record:
  75.       case T_Coexpr:
  76.       case T_External:
  77.      /*
  78.           * Collate these values according to the relative positions of
  79.           *  their blocks in the heap.
  80.       */
  81.          lresult = ((long)BlkLoc(*dp1) - (long)BlkLoc(*dp2));
  82.          if (lresult == 0)
  83.             return Equal;
  84.          return ((lresult > 0) ? Greater : Less);
  85.  
  86.       default:
  87.      syserr("anycmp: unknown datatype.");
  88.       }
  89.    }
  90.  
  91. /*
  92.  * order(x) - return collating number for object x.
  93.  */
  94.  
  95. int order(dp)
  96. dptr dp;
  97.    {
  98.    if (Qual(*dp))
  99.       return 3;          /* string */
  100.    switch (Type(*dp)) {
  101.       case T_Null:
  102.      return 0;
  103.       case T_Integer:
  104.      return 1;
  105.  
  106. #ifdef LargeInts
  107.       case T_Bignum:
  108.      return 1;
  109. #endif                    /* LargeInts */
  110.  
  111.       case T_Real:
  112.      return 2;
  113.       case T_Cset:
  114.      return 4;
  115.       case T_Coexpr:
  116.      return 5;
  117.       case T_File:
  118.      return 6;
  119.       case T_Proc:
  120.      return 7;
  121.       case T_List:
  122.      return 8;
  123.       case T_Table:
  124.      return 9;
  125.       case T_Set:
  126.      return 10;
  127.       case T_Record:
  128.      return 11;
  129.       case T_External:
  130.          return 12;
  131.       default:
  132.      syserr("order: unknown datatype.");
  133.       }
  134.    }
  135.  
  136. /*
  137.  * equiv - test equivalence of two objects.
  138.  */
  139.  
  140. int equiv(dp1, dp2)
  141. dptr dp1, dp2;
  142.    {
  143.    register int result;
  144.    register word i;
  145.    register char *s1, *s2;
  146.    double rres1, rres2;
  147.  
  148.    result = 0;
  149.  
  150.       /*
  151.        * If the descriptors are identical, the objects are equivalent.
  152.        */
  153.    if (EqlDesc(*dp1,*dp2))
  154.       result = 1;
  155.    else if (Qual(*dp1) && Qual(*dp2)) {
  156.  
  157.       /*
  158.        *  If both are strings of equal length, compare their characters.
  159.        */
  160.  
  161.       if ((i = StrLen(*dp1)) == StrLen(*dp2)) {
  162.  
  163.  
  164.      s1 = StrLoc(*dp1);
  165.      s2 = StrLoc(*dp2);
  166.      result = 1;
  167.      while (i--)
  168.        if (*s1++ != *s2++) {
  169.           result = 0;
  170.           break;
  171.           }
  172.  
  173.      }
  174.       }
  175.    else if (dp1->dword == dp2->dword)
  176.       switch (Type(*dp1)) {
  177.      /*
  178.       * For integers and reals, just compare the values.
  179.       */
  180.      case T_Integer:
  181.         result = (IntVal(*dp1) == IntVal(*dp2));
  182.         break;
  183.  
  184. #ifdef LargeInts
  185.      case T_Bignum:
  186.         result = (bigcmp(dp1, dp2) == 0);
  187.         break;
  188. #endif                    /* LargeInts */
  189.  
  190.  
  191.      case T_Real:
  192.             GetReal(dp1, rres1);
  193.             GetReal(dp2, rres2);
  194.             result = (rres1 == rres2);
  195.         break;
  196.  
  197.      case T_Cset:
  198.         /*
  199.          * Compare the bit arrays of the csets.
  200.          */
  201.         result = 1;
  202.         for (i = 0; i < CsetSize; i++)
  203.            if (BlkLoc(*dp1)->cset.bits[i] != BlkLoc(*dp2)->cset.bits[i]) {
  204.           result = 0;
  205.           break;
  206.           }
  207.      }
  208.    else
  209.       /*
  210.        * dp1 and dp2 are of different types, so they can't be
  211.        *  equivalent.
  212.        */
  213.       result = 0;
  214.  
  215.    return result;
  216.    }
  217.  
  218. /*
  219.  * lexcmp - lexically compare two strings.
  220.  */
  221.  
  222. int lexcmp(dp1, dp2)
  223. dptr dp1, dp2;
  224.    {
  225.  
  226.  
  227.    register char *s1, *s2;
  228.    register word minlen;
  229.    word l1, l2;
  230.  
  231.    /*
  232.     * Get length and starting address of both strings.
  233.     */
  234.    l1 = StrLen(*dp1);
  235.    s1 = StrLoc(*dp1);
  236.    l2 = StrLen(*dp2);
  237.    s2 = StrLoc(*dp2);
  238.  
  239.    /*
  240.     * Set minlen to length of the shorter string.
  241.     */
  242.    minlen = Min(l1, l2);
  243.  
  244.    /*
  245.     * Compare as many bytes as are in the smaller string.  If an
  246.     *  inequality is found, compare the differing bytes.
  247.     */
  248.    while (minlen--)
  249.       if (*s1++ != *s2++)
  250.      return ((*--s1 & 0377) > (*--s2 & 0377) ? Greater : Less);
  251.  
  252.    /*
  253.     * The strings compared equal for the length of the shorter.
  254.     */
  255.    if (l1 == l2)
  256.       return Equal;
  257.    else if (l1 > l2)
  258.       return Greater;
  259.    else
  260.       return Less;
  261.  
  262.    }
  263.  
  264. /*
  265.  * numcmp - compare two numbers.  Returns -1, 0, 1 for dp1 <, =, > dp2.
  266.  *  dp3 is made into a descriptor for the return value.
  267.  */
  268.  
  269. int numcmp(dp1, dp2, dp3)
  270. dptr dp1, dp2, dp3;
  271.    {
  272.    int t1, t2;
  273.    double r1, r2;
  274.    /*
  275.     * Be sure that both dp1 and dp2 are numeric.
  276.     */
  277.  
  278.    if ((t1 = cvnum(dp1)) == CvtFail)
  279.       RetError(102, *dp1);
  280.    if ((t2 = cvnum(dp2)) == CvtFail)
  281.       RetError(102, *dp2);
  282.  
  283.    if (t1 == T_Integer && t2 == T_Integer) {
  284.    /*
  285.     *  dp1 and dp2 are both integers, compare them and
  286.     *  create an integer descriptor in dp3
  287.     */
  288.  
  289.       *dp3 = *dp2;
  290.       if (IntVal(*dp1) == IntVal(*dp2))
  291.      return Equal;
  292.       return ((IntVal(*dp1) > IntVal(*dp2)) ? Greater : Less);
  293.       }
  294.    else if (t1 == T_Real || t2 == T_Real) {
  295.  
  296.    /*
  297.     *  Either dp1 or dp2 is real. Convert the other to a real,
  298.     *  compare them and create a real descriptor in dp3.
  299.     */
  300.  
  301.       if (t1 != T_Real) {
  302. #ifdef LargeInts
  303.      if (t1 == T_Bignum)
  304.         r1 = bigtoreal(dp1);
  305.      else
  306. #endif                    /* LargeInts */
  307.  
  308. #ifdef WATERLOO_C_V3_0
  309.             {
  310.         long int l;
  311.             double d;
  312.  
  313.             d = IntVal(*dp1);
  314.             r1 = d;
  315.             }
  316. #else                    /* WATERLOO_C_V3_0 */
  317.             r1 = IntVal(*dp1);
  318. #endif                    /* WATERLOO_C_V3_0 */
  319.          }
  320.       else
  321.      r1 = BlkLoc(*dp1)->realblk.realval;
  322.  
  323.       if (t2 != T_Real) {
  324. #ifdef LargeInts
  325.      if (t2 == T_Bignum)
  326.         r2 = bigtoreal(dp2);
  327.      else
  328. #endif                    /* LargeInts */
  329.  
  330. #ifdef WATERLOO_C_V3_0
  331.             {
  332.         long int l;
  333.             double d;
  334.  
  335.             d = IntVal(*dp2);
  336.             r2 = d;
  337.             }
  338. #else                    /* WATERLOO_C_V3_0 */
  339.             r2 = IntVal(*dp2);
  340. #endif                    /* WATERLOO_C_V3_0 */
  341.          }
  342.       else
  343.      r2 = BlkLoc(*dp2)->realblk.realval;
  344.      
  345.       if (makereal(r2, dp3) == Error)
  346.          return Error;
  347.       if (r1 == r2)
  348.      return Equal;
  349.       return ((r1 > r2) ? Greater : Less);
  350.       }
  351. #ifdef LargeInts
  352.    else {
  353.       int result;
  354.  
  355.       *dp3 = *dp2;
  356.       result = bigcmp(dp1, dp2);
  357.       if (result == 0)
  358.      return Equal;
  359.       return ((result > 0) ? Greater : Less);
  360.       }
  361. #endif                    /* LargeInts */
  362.    }
  363.  
  364. /*
  365.  * csetcmp - compare two cset bit arrays.
  366.  *  The order defined by this function is identical to the lexical order of
  367.  *  the two strings that the csets would be converted into.
  368.  */
  369.  
  370. int csetcmp(cs1, cs2)
  371. unsigned int *cs1, *cs2;
  372.    {
  373.    unsigned int nbit, mask, *cs_end;
  374.  
  375.    if (cs1 == cs2) return Equal;
  376.  
  377.    /*
  378.     * The longest common prefix of the two bit arrays converts to some
  379.     *  common prefix string.  The first bit on which the csets disagree is
  380.     *  the first character of the conversion strings that disagree, and so this
  381.     *  is the character on which the order is determined.  The cset that has
  382.     *  this first non-common bit = one, has in that position the lowest
  383.     *  character, so this cset is lexically least iff the other cset has some
  384.     *  following bit set.  If the other cset has no bits set after the first
  385.     *  point of disagreement, then it is a prefix of the other, and is therefor
  386.     *  lexically less.
  387.     *
  388.     * Find the first word where cs1 and cs2 are different.
  389.     */
  390.    for (cs_end = cs1 + CsetSize; cs1 < cs_end; cs1++, cs2++)
  391.       if (*cs1 != *cs2) {
  392.      /*
  393.       * Let n be the position at which the bits first differ within
  394.       *  the word.  Set nbit to some integer for which the nth bit
  395.       *  is the first bit in the word that is one.  Note here and in the
  396.       *  following, that bits go from right to left within a word, so
  397.       *  the _first_ bit is the _rightmost_ bit.
  398.       */
  399.      nbit = *cs1 ^ *cs2;
  400.  
  401.      /* Set mask to an integer that has all zeros in bit positions
  402.       *  upto and including position n, and all ones in bit positions
  403.       *  _after_ bit position n.
  404.       */
  405.      for (mask = (unsigned)MaxLong << 1; !(~mask & nbit); mask <<= 1);
  406.  
  407.      /*
  408.       * nbit & ~mask contains zeros everywhere except position n, which
  409.       *  is a one, so *cs2 & (nbit & ~mask) is non-zero iff the nth bit
  410.       *  of *cs2 is one.
  411.       */
  412.      if (*cs2 & (nbit & ~mask)) {
  413.         /*
  414.          * If there are bits set in cs1 after bit position n in the
  415.          *  current word, then cs1 is lexically greater than cs2.
  416.          */
  417.         if (*cs1 & mask) return Greater;
  418.         while (++cs1 < cs_end)
  419.            if (*cs1) return Greater;
  420.  
  421.         /*
  422.          * Otherwise cs1 is a proper prefix of cs2 and is therefore
  423.          *  lexically less.
  424.          */
  425.          return Less;
  426.          }
  427.  
  428.      /*
  429.       * If the nth bit of *cs2 isn't one, then the nth bit of cs1
  430.       *  must be one.  Just reverse the logic for the previous
  431.       *  case.
  432.       */
  433.      if (*cs2 & mask) return Less;
  434.      cs_end = cs2 + (cs_end - cs1);
  435.      while (++cs2 < cs_end)
  436.         if (*cs2) return Less;
  437.      return Greater;
  438.      }
  439.    return Equal;
  440.    }
  441.